home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / internet / vbipsmtp / dschat.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-08-16  |  19.2 KB  |  564 lines
  1. VERSION 2.00
  2. Begin Form frmMain 
  3.    BackColor       =   &H00C0C0C0&
  4.    BorderStyle     =   3  'Fixed Double
  5.    Caption         =   "Chat Sample Application"
  6.    ClientHeight    =   7545
  7.    ClientLeft      =   2115
  8.    ClientTop       =   585
  9.    ClientWidth     =   8115
  10.    FontBold        =   -1  'True
  11.    FontItalic      =   0   'False
  12.    FontName        =   "Arial"
  13.    FontSize        =   8.25
  14.    FontStrikethru  =   0   'False
  15.    FontUnderline   =   0   'False
  16.    Height          =   7950
  17.    Icon            =   DSCHAT.FRX:0000
  18.    Left            =   2055
  19.    LinkTopic       =   "Form1"
  20.    MaxButton       =   0   'False
  21.    ScaleHeight     =   7545
  22.    ScaleWidth      =   8115
  23.    Top             =   240
  24.    Width           =   8235
  25.    Begin dsSocket dsSocket2 
  26.       DataSize        =   2048
  27.       EOLChar         =   0
  28.       Left            =   5160
  29.       LineMode        =   0   'False
  30.       Linger          =   -1  'True
  31.       LocalPort       =   0
  32.       RemoteDotAddr   =   ""
  33.       RemoteHost      =   ""
  34.       RemotePort      =   0
  35.       ServiceName     =   ""
  36.       Timeout         =   10
  37.       Top             =   0
  38.    End
  39.    Begin dsSocket dsSocket1 
  40.       DataSize        =   2048
  41.       EOLChar         =   0
  42.       Left            =   4560
  43.       LineMode        =   0   'False
  44.       Linger          =   -1  'True
  45.       LocalPort       =   0
  46.       RemoteDotAddr   =   ""
  47.       RemoteHost      =   ""
  48.       RemotePort      =   0
  49.       ServiceName     =   ""
  50.       Timeout         =   10
  51.       Top             =   0
  52.    End
  53.    Begin CommandButton btnStopChat 
  54.       Caption         =   "Stop Chat"
  55.       Enabled         =   0   'False
  56.       FontBold        =   0   'False
  57.       FontItalic      =   0   'False
  58.       FontName        =   "MS Sans Serif"
  59.       FontSize        =   8.25
  60.       FontStrikethru  =   0   'False
  61.       FontUnderline   =   0   'False
  62.       Height          =   330
  63.       Left            =   6405
  64.       TabIndex        =   17
  65.       Top             =   1575
  66.       Width           =   1590
  67.    End
  68.    Begin CommandButton btnStopWaiting 
  69.       Caption         =   "Stop Waiting"
  70.       Enabled         =   0   'False
  71.       FontBold        =   0   'False
  72.       FontItalic      =   0   'False
  73.       FontName        =   "MS Sans Serif"
  74.       FontSize        =   8.25
  75.       FontStrikethru  =   0   'False
  76.       FontUnderline   =   0   'False
  77.       Height          =   330
  78.       Left            =   4830
  79.       TabIndex        =   16
  80.       Top             =   1575
  81.       Width           =   1590
  82.    End
  83.    Begin CommandButton btnChatSomeone 
  84.       Caption         =   "Chat Someone"
  85.       FontBold        =   0   'False
  86.       FontItalic      =   0   'False
  87.       FontName        =   "MS Sans Serif"
  88.       FontSize        =   8.25
  89.       FontStrikethru  =   0   'False
  90.       FontUnderline   =   0   'False
  91.       Height          =   330
  92.       Left            =   6405
  93.       TabIndex        =   15
  94.       Top             =   1260
  95.       Width           =   1590
  96.    End
  97.    Begin CommandButton btnWaitForChat 
  98.       Caption         =   "Wait for chat"
  99.       FontBold        =   0   'False
  100.       FontItalic      =   0   'False
  101.       FontName        =   "MS Sans Serif"
  102.       FontSize        =   8.25
  103.       FontStrikethru  =   0   'False
  104.       FontUnderline   =   0   'False
  105.       Height          =   330
  106.       Left            =   4830
  107.       TabIndex        =   14
  108.       Top             =   1260
  109.       Width           =   1590
  110.    End
  111.    Begin TextBox txReply 
  112.       BackColor       =   &H00FFFFFF&
  113.       Enabled         =   0   'False
  114.       FontBold        =   0   'False
  115.       FontItalic      =   0   'False
  116.       FontName        =   "MS Sans Serif"
  117.       FontSize        =   8.25
  118.       FontStrikethru  =   0   'False
  119.       FontUnderline   =   0   'False
  120.       Height          =   3060
  121.       Left            =   105
  122.       MultiLine       =   -1  'True
  123.       TabIndex        =   13
  124.       Top             =   3990
  125.       Width           =   7890
  126.    End
  127.    Begin TextBox txPortNumber 
  128.       BackColor       =   &H00FFFFFF&
  129.       FontBold        =   0   'False
  130.       FontItalic      =   0   'False
  131.       FontName        =   "MS Sans Serif"
  132.       FontSize        =   8.25
  133.       FontStrikethru  =   0   'False
  134.       FontUnderline   =   0   'False
  135.       Height          =   285
  136.       Left            =   6090
  137.       TabIndex        =   12
  138.       Top             =   630
  139.       Width           =   855
  140.    End
  141.    Begin TextBox txStatus 
  142.       BackColor       =   &H00C0C0C0&
  143.       FontBold        =   0   'False
  144.       FontItalic      =   0   'False
  145.       FontName        =   "MS Sans Serif"
  146.       FontSize        =   8.25
  147.       FontStrikethru  =   0   'False
  148.       FontUnderline   =   0   'False
  149.       Height          =   330
  150.       Left            =   105
  151.       TabIndex        =   10
  152.       Top             =   7140
  153.       Width           =   7890
  154.    End
  155.    Begin TextBox txMessage 
  156.       BackColor       =   &H00FFFFFF&
  157.       Enabled         =   0   'False
  158.       FontBold        =   0   'False
  159.       FontItalic      =   0   'False
  160.       FontName        =   "MS Sans Serif"
  161.       FontSize        =   8.25
  162.       FontStrikethru  =   0   'False
  163.       FontUnderline   =   0   'False
  164.       Height          =   1695
  165.       Left            =   105
  166.       MultiLine       =   -1  'True
  167.       TabIndex        =   9
  168.       Top             =   1995
  169.       Width           =   7890
  170.    End
  171.    Begin PictureBox Picture1 
  172.       BackColor       =   &H00C0C0C0&
  173.       BorderStyle     =   0  'None
  174.       Height          =   1065
  175.       Left            =   105
  176.       ScaleHeight     =   1065
  177.       ScaleWidth      =   4425
  178.       TabIndex        =   1
  179.       Top             =   630
  180.       Width           =   4425
  181.       Begin OptionButton opServerAddress 
  182.          BackColor       =   &H00C0C0C0&
  183.          Caption         =   "Use Server Address"
  184.          FontBold        =   0   'False
  185.          FontItalic      =   0   'False
  186.          FontName        =   "MS Sans Serif"
  187.          FontSize        =   8.25
  188.          FontStrikethru  =   0   'False
  189.          FontUnderline   =   0   'False
  190.          Height          =   225
  191.          Left            =   2310
  192.          TabIndex        =   7
  193.          Top             =   735
  194.          Width           =   2115
  195.       End
  196.       Begin OptionButton opServerName 
  197.          BackColor       =   &H00C0C0C0&
  198.          Caption         =   "Use Server Name"
  199.          FontBold        =   0   'False
  200.          FontItalic      =   0   'False
  201.          FontName        =   "MS Sans Serif"
  202.          FontSize        =   8.25
  203.          FontStrikethru  =   0   'False
  204.          FontUnderline   =   0   'False
  205.          Height          =   225
  206.          Left            =   210
  207.          TabIndex        =   6
  208.          Top             =   735
  209.          Value           =   -1  'True
  210.          Width           =   1905
  211.       End
  212.       Begin TextBox txServerAddress 
  213.          BackColor       =   &H00FFFFFF&
  214.          FontBold        =   0   'False
  215.          FontItalic      =   0   'False
  216.          FontName        =   "MS Sans Serif"
  217.          FontSize        =   8.25
  218.          FontStrikethru  =   0   'False
  219.          FontUnderline   =   0   'False
  220.          Height          =   285
  221.          Left            =   1575
  222.          TabIndex        =   5
  223.          Top             =   315
  224.          Width           =   2745
  225.       End
  226.       Begin TextBox txServerName 
  227.          BackColor       =   &H00FFFFFF&
  228.          FontBold        =   0   'False
  229.          FontItalic      =   0   'False
  230.          FontName        =   "MS Sans Serif"
  231.          FontSize        =   8.25
  232.          FontStrikethru  =   0   'False
  233.          FontUnderline   =   0   'False
  234.          Height          =   285
  235.          Left            =   1575
  236.          TabIndex        =   4
  237.          Top             =   0
  238.          Width           =   2745
  239.       End
  240.       Begin Label Label2 
  241.          Alignment       =   1  'Right Justify
  242.          BackColor       =   &H00C0C0C0&
  243.          Caption         =   "Server Address :"
  244.          FontBold        =   0   'False
  245.          FontItalic      =   0   'False
  246.          FontName        =   "MS Sans Serif"
  247.          FontSize        =   8.25
  248.          FontStrikethru  =   0   'False
  249.          FontUnderline   =   0   'False
  250.          Height          =   225
  251.          Left            =   0
  252.          TabIndex        =   3
  253.          Top             =   315
  254.          Width           =   1485
  255.       End
  256.       Begin Label Label1 
  257.          Alignment       =   1  'Right Justify
  258.          BackColor       =   &H00C0C0C0&
  259.          Caption         =   "Server Name :"
  260.          FontBold        =   0   'False
  261.          FontItalic      =   0   'False
  262.          FontName        =   "MS Sans Serif"
  263.          FontSize        =   8.25
  264.          FontStrikethru  =   0   'False
  265.          FontUnderline   =   0   'False
  266.          Height          =   225
  267.          Left            =   0
  268.          TabIndex        =   2
  269.          Top             =   0
  270.          Width           =   1485
  271.       End
  272.    End
  273.    Begin Label Label5 
  274.       Alignment       =   1  'Right Justify
  275.       BackColor       =   &H00C0C0C0&
  276.       Caption         =   "Port to Use :"
  277.       FontBold        =   0   'False
  278.       FontItalic      =   0   'False
  279.       FontName        =   "MS Sans Serif"
  280.       FontSize        =   8.25
  281.       FontStrikethru  =   0   'False
  282.       FontUnderline   =   0   'False
  283.       Height          =   225
  284.       Left            =   4850
  285.       TabIndex        =   11
  286.       Top             =   630
  287.       Width           =   1170
  288.    End
  289.    Begin Label laReply 
  290.       BackColor       =   &H00C0C0C0&
  291.       Caption         =   "Reply :"
  292.       Enabled         =   0   'False
  293.       FontBold        =   0   'False
  294.       FontItalic      =   0   'False
  295.       FontName        =   "MS Sans Serif"
  296.       FontSize        =   8.25
  297.       FontStrikethru  =   0   'False
  298.       FontUnderline   =   0   'False
  299.       Height          =   225
  300.       Left            =   105
  301.       TabIndex        =   0
  302.       Top             =   3780
  303.       Width           =   645
  304.    End
  305.    Begin Label laMessage 
  306.       BackColor       =   &H00C0C0C0&
  307.       Caption         =   "Message :"
  308.       Enabled         =   0   'False
  309.       FontBold        =   0   'False
  310.       FontItalic      =   0   'False
  311.       FontName        =   "MS Sans Serif"
  312.       FontSize        =   8.25
  313.       FontStrikethru  =   0   'False
  314.       FontUnderline   =   0   'False
  315.       Height          =   225
  316.       Left            =   105
  317.       TabIndex        =   8
  318.       Top             =   1785
  319.       Width           =   960
  320.    End
  321. Option Explicit
  322. '   Declare the constants used to set the Action property
  323. '   and check the State of the socket
  324. Const SOCK_ACTION_CLOSE = 1
  325. Const SOCK_ACTION_CONNECT = 2
  326. Const SOCK_ACTION_LISTEN = 3
  327. Const SOCK_STATE_CONNECTED = 2
  328. Const SOCK_ERR_CLOSED = 20000
  329. Dim nTextPos     As Integer
  330. Sub btnChatSomeone_Click ()
  331.     '   Setup to handle errors as they occur
  332.     On Error Resume Next
  333.     '   If the user selected to use the ServerName, then
  334.     '   set the properties accordingly.  If RemoteDotAddr is
  335.     '   blank, then the control will use the RemoteHost information
  336.     '   to resolve an address.
  337.     If (opServerName) Then
  338.         dsSocket2.RemoteHost = txServerName.Text
  339.         dsSocket2.RemoteDotAddr = ""
  340.     Else
  341.         dsSocket2.RemoteHost = ""
  342.         dsSocket2.RemoteDotAddr = txServerAddress.Text
  343.     End If
  344.     '   Setup the port for connecting to on the remote system
  345.     dsSocket2.RemotePort = Val(txPortNumber.Text)
  346.     '   If the socket is already connected, then this is an error
  347.     If (dsSocket2.State = SOCK_STATE_CONNECTED) Then
  348.         MsgBox "The socket is already connected to someone."
  349.     Else
  350.         '   show the status information
  351.         txStatus.Text = "Connecting to server..."
  352.         
  353.         '   issue the connect command
  354.         dsSocket2.Action = SOCK_ACTION_CONNECT
  355.         
  356.         '   if there were any errors establishing the connection
  357.         '   then report them
  358.         If (Err > 0) Then
  359.             txStatus.Text = Err & ":" & Error & "..."
  360.             btnChatSomeone.Enabled = True
  361.             btnWaitForChat.Enabled = True
  362.             laMessage.Enabled = False
  363.             txMessage.Enabled = False
  364.             laReply.Enabled = False
  365.             txReply.Enabled = False
  366.             Exit Sub
  367.         
  368.         '   else show the status
  369.         Else
  370.             txStatus.Text = "Connecting to server " + txServerName.Text + "..."
  371.         
  372.         End If
  373.     End If
  374. End Sub
  375. Sub btnStopChat_Click ()
  376.     On Error Resume Next
  377.     '   close the connection to the remote
  378.     dsSocket2.Action = SOCK_ACTION_CLOSE
  379.     '   If there were any errors then report them.  The Action property
  380.     '   will return errors in the standard VB error variables
  381.     If (Err > 0) Then
  382.         MsgBox "Error disconnecting." & Chr(13) & Format(Err) & " : " & Error
  383.         txStatus.Text = Error & "..."
  384.         Exit Sub
  385.     '   If no errors, just report the status
  386.     Else
  387.         txStatus.Text = "Disconnected from " + txServerName.Text + "..."
  388.         btnWaitForChat.Enabled = True
  389.         btnChatSomeone.Enabled = True
  390.         btnStopWaiting.Enabled = False
  391.         btnStopChat.Enabled = False
  392.     End If
  393. End Sub
  394. Sub btnStopWaiting_Click ()
  395.     On Error Resume Next
  396.     '   close the connection to the remote
  397.     dsSocket1.Action = SOCK_ACTION_CLOSE
  398.     '   If there were any errors then report them.  The Action property
  399.     '   will return errors in the standard VB error variables
  400.     If (Err > 0) Then
  401.         MsgBox "Error cancelling Listen." & Chr(13) & Format(Err) & " : " & Error
  402.         txStatus.Text = Error & "..."
  403.         Exit Sub
  404.     '   If no errors, just report the status
  405.     Else
  406.         txStatus.Text = "Listen cancelled..."
  407.         btnWaitForChat.Enabled = True
  408.         btnChatSomeone.Enabled = True
  409.         btnStopWaiting.Enabled = False
  410.         btnStopChat.Enabled = False
  411.     End If
  412. End Sub
  413. Sub btnWaitForChat_Click ()
  414.     On Error Resume Next
  415.     dsSocket1.LocalPort = Val(txPortNumber.Text)
  416.     '   accept any incoming connection on this port
  417.     dsSocket1.LocalDotAddr = "0.0.0.0"
  418.     dsSocket1.Action = SOCK_ACTION_LISTEN
  419.     '   If there were any errors then report them.  The Action property
  420.     '   will return errors in the standard VB error variables
  421.     If (Err > 0) Then
  422.         txStatus.Text = "Error listening for connection.  " & Err & ":" & Error & "..."
  423.         Exit Sub
  424.     '   If no errors, just report the status
  425.     Else
  426.         txStatus.Text = "Listening for connection " + txServerName.Text + "..."
  427.         btnWaitForChat.Enabled = False
  428.         btnChatSomeone.Enabled = False
  429.         btnStopWaiting.Enabled = True
  430.     End If
  431. End Sub
  432. Sub dsSocket1_Accept (CommID As Integer)
  433.     On Error Resume Next
  434.     '   setup dsSocket2 as the communication control
  435.     dsSocket2.Socket = CommID
  436.     '   close the listen so no ther connections arrive
  437.     dsSocket1.Action = SOCK_ACTION_CLOSE
  438.     If (frmMain.WindowState = 1) Then frmMain.WindowState = 0
  439.     '   if there were any errors sending the message
  440.     '   then report them
  441.     If (Err > 0) Then
  442.         txStatus.Text = "Error sending message to server.  " & Err & ":" & Error & "..."
  443.         btnChatSomeone.Enabled = True
  444.         btnWaitForChat.Enabled = True
  445.     '   else show the status
  446.     Else
  447.         txStatus.Text = "Connected to remote chat at " & dsSocket1.RemoteDotAddr
  448.         txMessage.Text = ""
  449.         btnChatSomeone.Enabled = False
  450.         btnWaitForChat.Enabled = False
  451.         btnStopWaiting.Enabled = False
  452.         btnStopChat.Enabled = True
  453.         txMessage.Enabled = True
  454.         txReply.Enabled = True
  455.         laMessage.Enabled = True
  456.         laReply.Enabled = True
  457.     End If
  458. End Sub
  459. Sub dsSocket1_Exception (ErrorCode As Integer, ErrorDesc As String)
  460.     '   ignore any errors caused when closing the socket.
  461.     '   we just want it closed
  462.     On Error Resume Next
  463.     txStatus.Text = ErrorDesc
  464.     dsSocket1.Action = SOCK_ACTION_CLOSE
  465.     laMessage.Enabled = False
  466.     txMessage.Enabled = False
  467.     laReply.Enabled = False
  468.     txReply.Enabled = False
  469. End Sub
  470. Sub dsSocket2_Close (ErrorCode As Integer, ErrorDesc As String)
  471.     btnStopWaiting.Enabled = False
  472.     btnWaitForChat.Enabled = True
  473.     btnChatSomeone.Enabled = True
  474.     btnStopChat.Enabled = False
  475.     txStatus.Text = ErrorDesc
  476.     laMessage.Enabled = False
  477.     txMessage.Enabled = False
  478.     laReply.Enabled = False
  479.     txReply.Enabled = False
  480. End Sub
  481. Sub dsSocket2_Connect ()
  482.     txStatus.Text = "Connected to server " + txServerName.Text + "..."
  483.     btnChatSomeone.Enabled = False
  484.     btnWaitForChat.Enabled = False
  485.     btnStopChat.Enabled = True
  486.     laMessage.Enabled = True
  487.     txMessage.Enabled = True
  488.     laReply.Enabled = True
  489.     txReply.Enabled = True
  490.     txMessage.Text = ""
  491. End Sub
  492. Sub dsSocket2_Exception (ErrorCode As Integer, ErrorDesc As String)
  493.     If (ErrorCode = 21054 Or ErrorCode = SOCK_ERR_CLOSED) Then
  494.         txStatus.Text = ErrorDesc
  495.         btnStopWaiting.Enabled = False
  496.         btnWaitForChat.Enabled = True
  497.         btnChatSomeone.Enabled = True
  498.         btnStopChat.Enabled = False
  499.     Else
  500.         txStatus.Text = ErrorDesc
  501.         '   close the socket on exceptions
  502.         dsSocket2.Action = SOCK_ACTION_CLOSE
  503.     End If
  504.     laMessage.Enabled = False
  505.     txMessage.Enabled = False
  506.     laReply.Enabled = False
  507.     txReply.Enabled = False
  508. End Sub
  509. Sub dsSocket2_Receive (ReceiveData As String)
  510.     '
  511.     '   Process data echoed back from server
  512.     '
  513.     On Error Resume Next
  514.     '   Display the data in the textbox
  515.     txReply.Text = txReply.Text & ReceiveData
  516. End Sub
  517. Sub Form_Paint ()
  518.     '
  519.     '   This is simply some pretty header code
  520.     '
  521.     '   Setup to do a shadowed text title and copyright notice.
  522.     FontSize = 30
  523.     FontItalic = True
  524.     Forecolor = &H808080
  525.     CurrentX = 140
  526.     CurrentY = -50
  527.     Print "Chat"
  528.     Forecolor = &HFF0000
  529.     CurrentX = 170
  530.     CurrentY = -20
  531.     Print "Chat"
  532.     FontSize = 12
  533.     CurrentX = 1800
  534.     CurrentY = 300
  535.     Print Chr(169) & "Dolphin Systems Inc."
  536. End Sub
  537. Sub Form_Unload (Cancel As Integer)
  538.     '   ensure that the sockets are closed, ignore any errors
  539.     On Error Resume Next
  540.     dsSocket1.Action = SOCK_ACTION_CLOSE
  541.     dsSocket2.Action = SOCK_ACTION_CLOSE
  542. End Sub
  543. Sub SendMessage (szMsg As String)
  544.     On Error Resume Next
  545.     '   send the message string to the remote system
  546.     dsSocket2.Send = szMsg
  547.     '   if there were any errors sending the message
  548.     '   then report them
  549.     If (Err > 0) Then
  550.         MsgBox "Error sending data to server." & Chr(13) & Format(Err) & " : " & Error
  551.         txStatus.Text = Error & "..."
  552.     '   else show the status
  553.     Else
  554.         txStatus.Text = Format(Len(szMsg)) + " bytes sent to server..."
  555.     End If
  556. End Sub
  557. Sub txMessage_KeyDown (KeyCode As Integer, Shift As Integer)
  558.     If (KeyCode = 13) Then
  559.         SendMessage (txMessage.Text) + Chr(13) + Chr(10)
  560.         txMessage.Text = ""
  561.         KeyCode = 0
  562.         End If
  563. End Sub
  564.